home *** CD-ROM | disk | FTP | other *** search
-
- (*
- ** VGA graphics unit
- ** Contains only USEFULL procedures (who ever needs 'circle'???)
- ** By Bas van Gaalen
- *)
-
- unit u_vga;
-
- interface
-
- const
- maxsprites=256;
- u_border:boolean=false; { used to set (or not) the bordercolor, for timing }
- u_vidseg:word=$a000; { VGA video-segment }
- vidptr:pointer=ptr($a000,0); { pointer to videomemory }
- u_miny:byte=1; { screen edges (for polygon-clipping) }
- u_maxy=199;
- u_minx:word=1;
- u_maxx=319;
- font8x14=2; { font constants for getfont-proc }
- font8x8=3;
- font8x8top=4;
- font9x14=5;
- font8x16=6;
- font9x16=7;
-
- black=0; { color constants }
- blue=1;
- green=2;
- cyan=3;
- red=4;
- magenta=5;
- brown=6;
- lightgray=7;
- darkgray=8;
- lightblue=9;
- lightgreen=10;
- lightcyan=11;
- lightred=12;
- lightmagenta=13;
- yellow=14;
- white=15;
- _blue=blue shl 4;
- _green=green shl 4;
- _cyan=cyan shl 4;
- _red=red shl 4;
- _magenta=magenta shl 4;
- _brown=brown shl 4;
- _lightgray=lightgray shl 4;
- blink=128;
-
- type
- spriterec=record { sprite structure }
- px, { previous xpos }
- py, { previous ypos }
- xpos, { x position }
- ypos, { y position }
- xsize, { horizontal size of sprite }
- ysize:word; { vertical size of sprite }
- buf:pointer; { pointer to buffer with sprite-data }
- seethru:integer; { < 0: no seethru, else seethru-color }
- transparant:boolean; { transparant: colors are or'ed with background }
- end;
- spritestruc=array[1..maxsprites] of spriterec;
-
- const
- sprsize=sizeof(spriterec); { size of sprite structure }
-
- var
- sprite:spritestruc;
- destenation, { destenation virtual memory }
- font:pointer; { pointer to font }
- u_lm:word; { to store last video mode }
- usefont:byte;
- destseg:word;
-
- { procedures of Bas van Gaalen }
- procedure setvideo(md:word); { set text/graphics video mode }
- function getvideo:word;
- procedure setborder(c:byte); { set color of border }
- procedure vretrace; { wait for vertical retrace }
- procedure hretrace; { wait for horizontal retrace }
- procedure displaypic(x,y:word; pic:pointer; xs,ys:word); { display picture }
- procedure cls(dst:pointer; size:word); { clear (part of) memory }
- procedure flip(src,dst:pointer; size:word); { alternate move }
- {procedure putpixel(c:byte; x,y:integer);}
- procedure putpixel(x,y:word; c:byte);
- function getpixel(x,y:word):byte;
- procedure floodfill(x,y:word; col:byte);
- procedure vga_line(x,y,x2,y2:integer; c:byte);
- procedure scalepic(pic:pointer; xsize,ysize,x,y,x1,y1:word); { scale }
- procedure polygon(x1,y1,x2,y2,x3,y3,x4,y4,xo,yo:integer; c:byte);
- procedure vga_copy(x,y,x2,y2,destx,desty:word);
- procedure vga_fill(x,y,x2,y2:word; c:byte);
- procedure writetxt(s:string; x,y:word; c:byte);
- procedure getfont(fontnr:byte);
-
- { sprite procedures }
- procedure movesprabs(nr:byte; x,y:word); { move sprite absolute }
- procedure movesprrel(nr:byte; x,y:integer); { move sprite relative to prev pos }
- procedure putback(src,dst:pointer; nr:byte); { restore background of sprite nr }
- procedure putsprite(nr:byte);
-
- { procedures of Jeroen Bouwens }
- procedure texture(x1,y1,u1,v1,x2,y2,u2,v2,x3,y3,u3,v3:integer;
- texseg,texofs:word;colorinc:byte);
- procedure gouraud(x1,y1,i1,x2,y2,i2,x3,y3,i3:integer);
- procedure triangle(x1,y1,x2,y2,x3,y3:integer; color:byte);
- procedure gouraudtexture(x1,y1,u1,v1,i1,x2,y2,u2,v2,i2,x3,y3,u3,v3,i3:integer;
- texseg,texofs,pictwidth:word);
-
- implementation
-
-